home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / comprs.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  2.1 KB  |  70 lines
  1.       subroutine comprs(icode,limit)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c      this routine compresses all available memory into a single block.
  5. c if *icode* is zero, compression of memory from word 1 to *limit* is
  6. c done;  otherwise, compression from *ldval* down to *limit* is done.
  7. c
  8. c spice version 2g.6  sccsid=memmgr 3/15/83
  9.       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl,
  10.      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4,
  11.      2   nwd8,nwd16
  12.       if (icode.ne.0) go to 100
  13.       nblk=numblk
  14.       ltab2=loctab
  15.    10 ltab1=ltab2
  16.       if (ltab1.ge.limit) go to 200
  17.       if (nblk.eq.1) go to 200
  18.       nblk=nblk-1
  19.       ltab2=ltab1+ntab
  20.       morg=istack(ltab1+1)
  21.       msiz=istack(ltab1+2)
  22.       muse=nxtevn(istack(ltab1+3))
  23.       mslp=istack(ltab1+6)
  24.       if ((msiz-muse).le.mslp) go to 10
  25.       muse=muse+mslp
  26. c...  move succeeding block down
  27.       morg2=istack(ltab2+1)
  28.       muse2=istack(ltab2+3)
  29.       madr2=istack(ltab2+4)
  30.       iwsize=istack(ltab2+5)
  31.       if (madr2.ne.0) go to 15
  32.       if (muse2.eq.0) go to 20
  33.    15 cpyknt=cpyknt+dble(muse2)
  34.       call copy4(istack(nwoff+morg2+1),istack(nwoff+morg+muse+1),muse2)
  35.       istack(lorg+madr2)=(morg+muse)/iwsize
  36.    20 istack(ltab1+2)=muse
  37.       istack(ltab2+1)=morg+muse
  38.       istack(ltab2+2)=istack(ltab2+2)+(msiz-muse)
  39.       go to 10
  40. c
  41. c
  42.   100 nblk=numblk
  43.       ltab2=ldval-ntab
  44.   110 ltab1=ltab2
  45.       if (ltab1.le.limit) go to 200
  46.       if (nblk.eq.1) go to 200
  47.       nblk=nblk-1
  48.       ltab2=ltab1-ntab
  49.       morg=istack(ltab1+1)
  50.       msiz=istack(ltab1+2)
  51.       muser=istack(ltab1+3)
  52.       muse=nxtevn(muser)
  53.       madr=istack(ltab1+4)
  54.       iwsize=istack(ltab1+5)
  55.       mslp=istack(ltab1+6)
  56.       if ((msiz-muse).le.mslp) go to 110
  57.       muse=muse+mslp
  58.       mspc=msiz-muse
  59.       cpyknt=cpyknt+dble(muser)
  60.       call copy4(istack(nwoff+morg+1),istack(nwoff+morg+mspc+1),muser)
  61.       istack(ltab1+1)=morg+mspc
  62.       istack(ltab1+2)=muse
  63.       istack(ltab2+2)=istack(ltab2+2)+mspc
  64.       if (madr.eq.0) go to 110
  65.       istack(lorg+madr)=(morg+mspc)/iwsize
  66.       go to 110
  67. c...  all done
  68.   200 return
  69.       end
  70.